home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue35 / pageprnt / PAGEPRNT.ZIP / PagePrnt / TestIt / UNIT1.PAS < prev   
Pascal/Delphi Source File  |  1997-10-21  |  5KB  |  165 lines
  1. unit Unit1;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   PagePrnt, ExtCtrls, StdCtrls, Buttons;
  8.  
  9. type
  10.   TMainForm = class(TForm)
  11.     Prn: TPagePrinter;
  12.     Panel1: TPanel;
  13.     btnPreview: TButton;
  14.     lblPage: TLabel;
  15.     btnNextPage: TSpeedButton;
  16.     btnPrevPage: TSpeedButton;
  17.     Label4: TLabel;
  18.     ZoomList: TComboBox;
  19.     ZoomTimer: TTimer;
  20.     btnPrint: TButton;
  21.     procedure btnPreviewClick(Sender: TObject);
  22.     procedure FormShow(Sender: TObject);
  23.     procedure btnNextPageClick(Sender: TObject);
  24.     procedure btnPrevPageClick(Sender: TObject);
  25.     procedure ZoomListKeyPress(Sender: TObject; var Key: Char);
  26.     procedure ZoomListClick(Sender: TObject);
  27.     procedure ZoomTimerTimer(Sender: TObject);
  28.     procedure btnPrintClick(Sender: TObject);
  29.   private
  30.     { Private declarations }
  31.   public
  32.     { Public declarations }
  33.   end;
  34.  
  35. var
  36.   MainForm: TMainForm;
  37.  
  38. implementation
  39.  
  40. {$R *.DFM}
  41.  
  42. procedure TMainForm.btnPreviewClick(Sender: TObject);
  43. var
  44.    Bitmap: TBitmap;
  45. begin
  46.      with Prn do
  47.      begin
  48.           BeginDoc;
  49.           //Use WriteTableLine
  50.           WriteTableLine('Tiny but cute words are best.|Tiny but cute words are best.|Tiny but cute words are best.');
  51.           WriteTableLine('A man, a plan, a canal: Panama!|A man, a plan, a canal: Panama!|A man, a plan, a canal: Panama!');
  52.           NewLine;
  53.           //Use Write, NewLine, and WriteLine
  54.           Write('First Font');
  55.           Font.Size:=Font.Size+10;
  56.           Write(' Second Font');
  57.           Font.Size:=Font.Size+10;
  58.           Write(' 3rd Font');
  59.           Font.Size:=Font.Size-10;
  60.           Write(' Fourth Font');
  61.           NewLine;
  62.           WriteLine('We can use a NewLine after using Write');
  63.           NewLine;
  64.           //Use WriteLines
  65.           Font.Size:=10;
  66.           WriteLines(false);
  67.           //Do some canvas doodling.
  68.           NewPage;
  69.           WriteLine('These figures will appear in the preview, but they may or may not print on your printer because of limitations with dithering colors in various printer drivers.');
  70.           Canvas.Pen.Color := clRed;
  71.           Canvas.PolyLine([Point(600, 600), Point(900, 600), Point(900, 900), Point(600, 900), Point(750, 750), Point(600, 600)]);
  72.           Canvas.Brush.Color:=clWhite;
  73.           Bitmap:=TBitmap.Create;
  74.           try
  75.              Bitmap.LoadFromFile('TestIt.bmp');
  76.              Canvas.BrushCopy( Rect(1000, 1000, 1000+4*Bitmap.Width, 1000+4*Bitmap.Height),
  77.                                Bitmap, Rect(0,0,Bitmap.Width, Bitmap.Height), clLime);
  78.           finally
  79.                  Bitmap.Free;
  80.           end;
  81.           EndDoc;
  82.           lblPage.Caption:=IntToStr(PageNumber)+' of '+IntToStr(PageCount);
  83.      end;
  84. end;
  85.  
  86. procedure TMainForm.FormShow(Sender: TObject);
  87. begin
  88.      lblPage.Caption:=IntToStr(Prn.PageNumber)+' of '+IntToStr(Prn.PageCount);
  89. end;
  90.  
  91. procedure TMainForm.btnNextPageClick(Sender: TObject);
  92. begin
  93.      if Prn.PageNumber < Prn.PageCount then
  94.      begin
  95.           Prn.PageNumber:=Prn.PageNumber+1;
  96.           FormShow(Sender);
  97.      end;
  98. end;
  99.  
  100. procedure TMainForm.btnPrevPageClick(Sender: TObject);
  101. begin
  102.      if Prn.PageNumber > 1 then
  103.      begin
  104.           Prn.PageNumber:=Prn.PageNumber-1;
  105.           FormShow(Sender);
  106.      end;
  107. end;
  108.  
  109. procedure TMainForm.ZoomListKeyPress(Sender: TObject; var Key: Char);
  110. begin
  111.      if Key = #13 then
  112.      begin
  113.           try
  114.              Prn.ZoomPercent:=StrToInt(ZoomList.Text);
  115.           except
  116.                 on EConvertError do ;
  117.           end;
  118.           Key:=#0;
  119.      end;
  120. end;
  121.  
  122. procedure TMainForm.ZoomListClick(Sender: TObject);
  123. begin
  124.      case ZoomList.ItemIndex of
  125.           0: Prn.ZoomPercent := 200;
  126.           1: Prn.ZoomPercent := 175;
  127.           2: Prn.ZoomPercent := 150;
  128.           3: Prn.ZoomPercent := 125;
  129.           4: Prn.ZoomPercent := 100;
  130.           5: Prn.ZoomPercent := 50;
  131.           6: Prn.ZoomToWidth;
  132.           7: Prn.ZoomToHeight;
  133.           8: Prn.ZoomToFit;
  134.      end;
  135.      ZoomTimer.Enabled:=True;
  136. end;
  137.  
  138. procedure TMainForm.ZoomTimerTimer(Sender: TObject);
  139. begin
  140.      {This kludge is necessary to display the actual zoom percent
  141.      after Fit To Width, Fit To Height, or Whole Page are chosen.
  142.      If you assign something (e.g. ZoomPercent) to TComboBox.Text
  143.      inside of TComboBox.OnClick, it gets overwritten with the
  144.      selected item's text right after the OnClick handler returns.
  145.      To get around this, I made this timer update the text property
  146.      after all the TComboBox event handling is finished.
  147.      If someone knows a better way, please let me know!}
  148.      ZoomTimer.Enabled:=False;
  149.      ZoomList.Text:=IntToStr(Prn.ZoomPercent)+'%';
  150. end;
  151.  
  152. procedure TMainForm.btnPrintClick(Sender: TObject);
  153. begin
  154.      if Prn.PageCount > 0 then
  155.      begin
  156.           if not Prn.Print then
  157.              MessageDlg('You cancelled printing.', mtInformation, [mbOk], 0);
  158.      end
  159.      else
  160.          MessageDlg('There is nothing to print.  Press preview first.',
  161.              mtInformation, [mbOk], 0);
  162. end;
  163.  
  164. end.
  165.